      ***************************************************************
       IDENTIFICATION DIVISION.
      ***************************************************************
       PROGRAM-ID.    P231F05.
       AUTHOR.        B.W. MCNULTY.
       DATE-WRITTEN.  APRIL 1, 1994.
      ***************************************************************
      *                                                             *
      *   PROGRAM:  P231F05 - FDAT - REPORT UPDATE                  *
      *                                                             *
      *   SYSTEM:   FDAT - TABLE MAINTENANCE SYSTEM                 *
      *                                                             *
      *   FUNCTION: THIS PROGRAM DISPLAYS ALL NECESSARY FIELDS      *
      *             WHICH MAKE UP THE EIGHT INDIVIDUAL REPORT       *
      *             RECORD TYPES AND 3 COMMENT LINES.               *
      *                                                             *
      *   LANGUAGE: COBOL II / SQL / CICS                           *
      *                                                             *
      *   ENTRY:    CICS TRANSACTION ID "FD05" THRU "FDAT"          *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   DATABASE TABLES AND FILES:                                *
      *                                                             *
      *       T231ACS  - SECURITY ACCESS TABLE                      *
      *       T231SEC  - SECURITY DISTIRBUTION TABLE                *
      *       T231DIST - DISTRIBUTION TABLE                         *
      *       T231BOOK - BOOK TABLE                                 *
      *       T231RPT  - REPORT TABLE                               *
      *       T231LINE - LINE TABLE                                 *
      *       T231COL  - COLUMN TABLE                               *
      *       T231ORG  - ORGANIZATION TABLE                         *
      *       T231RGN  - REGION TABLE                               *
      *       T231PRIM - PRIME TABLE                                *
      *       T231MNEM - G/L MNEMONICS TABLE                        *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   CALLED SUBROUTINES:                                       *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   MODIFICATIONS:                                            *
      *                                                             *
      *   DATE      PROGRAMMER     DESCRIPTION                      *
      *   --------  -------------  -------------------------------  *
      *   04/01/94  B.W. MCNULTY   ORIGINAL VERSION.                *
      *                                                             *
      ***************************************************************

       ENVIRONMENT DIVISION.

           EJECT
       DATA DIVISION.

       WORKING-STORAGE SECTION.

       01  FILLER                      PIC X(35) VALUE
           'WORKING STORAGE BEGINS HERE ======>'.
      **===========================================================**
      **   PROGRAM ID CONSTANTS                                    **
      **===========================================================**
       01  W0000-PROGRAM-INFO.
           05  PROGRAM-NAME            PIC  X(08)  VALUE 'P231F05'.
           05  MAP-NAME                PIC  X(08)  VALUE 'M231F05'.
           05  SET-NAME                PIC  X(08)  VALUE 'M231F05'.
           05  MAP-NAME-1              PIC  X(08)  VALUE 'M231F05'.
           05  MAP-NAME-A              PIC  X(08)  VALUE 'M231F5A'.
           05  TXN-ID                  PIC  X(04)  VALUE 'FD05'.
           05  MAP-DATA                PIC  X(1920)  VALUE SPACES.

           05  ERROR-FLAG              PIC  X(01)  VALUE 'N'.
               88  NO-ERRORS                       VALUE 'N'.
               88  ERRORS                          VALUE 'Y'.

           05  M-MSG-24I               PIC  X(80)  VALUE SPACES.

      **===========================================================**
      **   MISCELLANEOUS WORK FIELDS                               **
      **===========================================================**
           EJECT
       01  W0001-MISCELLANEOUS-FIELDS.
           05  W0001-PGM-XCTL-NO       PIC  X(08)  VALUE SPACES.
           05  W0001-TXN-ID            PIC  X(04)  VALUE SPACES.
           05  W0001-XCTL-PGM-ID       PIC  X(08)  VALUE 'P231F05'.
           05  W0001-LINK-PGM-ID       PIC  X(08)  VALUE 'P231F05'.
           05  W0001-LINK-CA           PIC  X(999) VALUE SPACES.
           05  W0001-SCREEN-LINE-LIMIT PIC S9(09)  COMP-3 VALUE +14.
           05  W0001-SCREEN-A-LN-LIMIT PIC S9(09)  COMP-3 VALUE +13.

           05  W0001-ABSTIME           PIC S9(16)  COMP.
           05  W0001-HHCMMCSS.
               10  W0001-HR            PIC  X(02).
               10  W0001-C1            PIC  X(01).
               10  W0001-MIN           PIC  X(02).
               10  W0001-C2            PIC  X(01).
               10  W0001-SEC           PIC  X(02).
           05  W0001-MMSDDSYY.
               10  W0001-MON           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-DAY           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-YEAR          PIC  X(02).
           05  W0001-YYYY.
               10  W0001-YY            PIC  X(04).

           05  W0001-DB2-ZERO-DATE     PIC  X(10) VALUE '01/01/0001'.
           05  W0001-DB2-MAX-DATE      PIC  X(10) VALUE '12/31/9999'.
           05  W0001-DB2-DATE.
               10  W0001-DB2-MM        PIC  X(02)  VALUE '01'.
               10  W0001-DB2-DASH1     PIC  X(01)  VALUE '/'.
               10  W0001-DB2-DD        PIC  X(02)  VALUE '01'.
               10  W0001-DB2-DASH2     PIC  X(01)  VALUE '/'.
               10  W0001-DB2-CC        PIC  X(02)  VALUE '19'.
               10  W0001-DB2-YY        PIC  X(02)  VALUE '99'.
           05  W0001-MMYY-DATE.
               10  W0001-MM            PIC  X(02).
               10  W0001-YY            PIC  X(02).

           05  W0001-X                 PIC S9(09)  COMP.
           05  W0001-IX                PIC S9(09)  COMP.
           05  W0001-IX2               PIC S9(09)  COMP.

           05  W0001-PD-X                      PIC X(02).
           05  W0001-PD  REDEFINES W0001-PD-X  PIC 9(02).

           05  W0001-FISCAL-PERIOD.
               10  W0001-FISCAL-CC       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-YY       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-MM       PIC  X(02)  VALUE SPACES.

           05  W0001-FYPD.
               10  W0001-FYPD-YY         PIC  X(02)  VALUE SPACES.
               10  W0001-FYPD-MM         PIC  X(02)  VALUE SPACES.

           05  W0001-SELECTION-FLAG      PIC  X(01)  VALUE 'N'.
               88  W0001-LINES-SELECTED              VALUE 'Y'.
               88  W0001-NO-LINES-SELECTED           VALUE 'N'.

           05  W0001-RGN-DESC            PIC X(25)
                   VALUE 'REGION LIST'.
           05  W0001-RGN-HDG-1           PIC X(75)
                   VALUE 'RGN  DESCRIPTION'.
           05  W0001-RGN-HDG-2           PIC X(75)
                   VALUE ALL '-'.
           05  W0001-LINE-DESC           PIC X(25)
                   VALUE 'LINE LIST'.
           05  W0001-LINE-HDG-1          PIC X(75)
                   VALUE 'LINE  DESCRIPTION'.
           05  W0001-LINE-HDG-2          PIC X(75)
                   VALUE ALL '-'.
           05  W0001-COL-DESC            PIC X(25)
                   VALUE 'COLUMN LIST'.
           05  W0001-COL-HDG-1           PIC X(75)
                   VALUE 'COL  DESCRIPTION'.
           05  W0001-COL-HDG-2           PIC X(75)
                   VALUE ALL '-'.
           05  W0001-ORG-DESC            PIC X(25)
                   VALUE 'ORGANIZATION LIST'.
           05  W0001-ORG-HDG-1           PIC X(75)
                   VALUE 'ORG  DESCRIPTION'.
           05  W0001-ORG-HDG-2           PIC X(75)
                   VALUE ALL '-'.
           05  W0001-MNEM-DESC           PIC X(25)
                   VALUE 'MNEMONIC LIST'.
           05  W0001-MNEM-HDG-1          PIC X(75)
                   VALUE 'MNEMONIC    PD HDG 01     PD HDG 02'.
           05  W0001-MNEM-HDG-2          PIC X(75)
                   VALUE ALL '-'.

           EJECT
       01  W0002-OUTPUT-FIELDS.
           05  W0002-T231LINE.
               10  W0002-F-LN-C          PIC X(03) VALUE SPACES.
               10  FILLER                PIC X(03) VALUE SPACES.
               10  W0002-F-LN-X          PIC X(80) VALUE SPACES.

           05  W0002-T231COL.
               10  W0002-F-COL-C         PIC X(03) VALUE SPACES.
               10  FILLER                PIC X(01) VALUE SPACES.
               10  W0002-F-COL-X         PIC X(80) VALUE SPACES.

           05  W0002-T231RGN.
               10  W0002-F-RGN-C         PIC X(02) VALUE SPACES.
               10  FILLER                PIC X(03) VALUE SPACES.
               10  W0002-F-RGN-X         PIC X(80) VALUE SPACES.

           05  W0002-T231ORG.
               10  W0002-F-ORG-C         PIC X(02) VALUE SPACES.
               10  FILLER                PIC X(03) VALUE SPACES.
               10  W0002-F-ORG-X         PIC X(80) VALUE SPACES.

           05  W0002-T231MNEM.
               10  W0002-F-MNEM-C        PIC X(03) VALUE SPACES.
               10  FILLER                PIC X(09) VALUE SPACES.
               10  W0002-F-PDHDG01-C     PIC X(12) VALUE SPACES.
               10  FILLER                PIC X(02) VALUE SPACES.
               10  W0002-F-PDHDG02-C     PIC X(12) VALUE SPACES.

           EJECT
      **===========================================================**
      **   FDAT - TRANSACTION ID'S                                 **
      **===========================================================**
           COPY C231WTXN.

           EJECT
      **===========================================================**
      **   PROGRAM MAP AREA                                        **
      **===========================================================**
           COPY M231F05.

           EJECT
      **===========================================================**
      **   CICS COPYBOOKS AREA                                     **
      **===========================================================**
           COPY C108CDBA.

           EJECT
           COPY DFHAID.

           EJECT
           COPY C751CONW.

           EJECT
           COPY C231MSGS.

           EJECT
           COPY C108W900.

           EJECT
           COPY C108W998.

           EJECT
           COPY D972ERRM.

           EJECT
      **===========================================================**
      **   DATE ROUTINE.                                           **
      **===========================================================**
           COPY NSDTREC.

           EJECT
      **===========================================================**
      **   WORKING STORAGE COMMAREA                                **
      **===========================================================**
           COPY C231COMM.
               10  MAP-SAVE-AREA REDEFINES CA-MAP-SAVE-AREA.
                   15  ACTIVE-MAP-FLAG            PIC  X(01).
                       88  MAP-1-ACTIVE           VALUE '1'.
                       88  MAP-A-ACTIVE           VALUE 'A'.

                   15  DISPLAY-MODE-FLAG          PIC  X(01).
                       88  DISPLAY-REGIONS        VALUE 'R'.
                       88  DISPLAY-LINES          VALUE 'L'.
                       88  DISPLAY-COLUMNS        VALUE 'C'.
                       88  DISPLAY-ORGS           VALUE 'O'.
                       88  DISPLAY-MNEMONICS      VALUE 'M'.

                   15  DELETE-REQUESTED-FLAG      PIC  X(01).
                       88  DELETE-REQUESTED       VALUE 'Y'.
                       88  DELETE-NOT-REQUESTED   VALUE 'N'.

                   15  WS-M-INDEX                 PIC S9(04) COMP.

                   15  WS-M-MIN-VALUES.
                       20  WS-M-MIN-LN-C          PIC  X(03).
                       20  WS-M-MIN-LN-N          PIC  X(03).
                       20  WS-M-MIN-COL-C         PIC  X(03).
                       20  WS-M-MIN-COL-N         PIC  X(03).
                       20  WS-M-MIN-RGN-C         PIC  X(02).
                       20  WS-M-MIN-ORG-C         PIC  X(02).
                       20  WS-M-MIN-MNEM-C        PIC  X(03).
                       20  WS-M-MIN-RECTYP-C      PIC  X(01).
                       20  WS-M-MIN-SEQ-N         PIC S9(09) COMP.

                   15  WS-M-MAX-VALUES.
                       20  WS-M-MAX-LN-C          PIC  X(03).
                       20  WS-M-MAX-LN-N          PIC  X(03).
                       20  WS-M-MAX-COL-C         PIC  X(03).
                       20  WS-M-MAX-COL-N         PIC  X(03).
                       20  WS-M-MAX-RGN-C         PIC  X(02).
                       20  WS-M-MAX-ORG-C         PIC  X(02).
                       20  WS-M-MAX-MNEM-C        PIC  X(03).
                       20  WS-M-MAX-RECTYP-C      PIC  X(01).
                       20  WS-M-MAX-SEQ-N         PIC S9(09) COMP.

                   15  WS-M-DB-SAVE OCCURS 14 TIMES.
                       20  WS-M-F-RPTID-C         PIC  X(08).
                       20  WS-M-DB-RECTYP-C       PIC  X(02).
                       20  WS-M-A-SEQ-N           PIC S9(09) COMP-3.
                       20  WS-M-F-PRNT-C          PIC  X(01).
                       20  WS-M-F-RPTFMT-C        PIC  X(01).
                       20  WS-M-F-STDRPT-C        PIC  X(01).
                       20  WS-M-F-ELIM-C          PIC  X(01).
                       20  WS-M-F-COLCALC-C       PIC  X(01).
                       20  WS-M-F-ORG-C           PIC  X(02).
                       20  WS-M-F-RGN-C           PIC  X(02).
                       20  WS-M-F-LN-C            PIC  X(03).
                       20  WS-M-F-COL-C           PIC  X(03).
                       20  WS-M-F-RPTID-X         PIC  X(75).
                       20  WS-M-F-PD01-C          PIC  X(04).
                       20  WS-M-F-PD02-C          PIC  X(04).
                       20  WS-M-F-PD03-C          PIC  X(04).
                       20  WS-M-F-PD04-C          PIC  X(04).
                       20  WS-M-F-PD05-C          PIC  X(04).
                       20  WS-M-F-PD06-C          PIC  X(04).
                       20  WS-M-F-PD07-C          PIC  X(04).
                       20  WS-M-F-PD08-C          PIC  X(04).
                       20  WS-M-F-PD09-C          PIC  X(04).
                       20  WS-M-F-PD10-C          PIC  X(04).
                       20  WS-M-F-PD11-C          PIC  X(04).
                       20  WS-M-F-PD12-C          PIC  X(04).
                       20  WS-M-F-PD13-C          PIC  X(04).
                       20  WS-M-F-PD14-C          PIC  X(04).


           EJECT
      **===========================================================**
      **   DB2 INCLUDES                                            **
      **===========================================================**
           EXEC SQL
                INCLUDE SQLCA
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ACS
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231SEC
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231DIST
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231BOOK
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231RPT
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231LINE
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231COL
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231ORG
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231RGN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231PRIM
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE T231MNEM
           END-EXEC.

           EJECT
      **===========================================================**
      **   DB2 CURSORS                                             **
      **===========================================================**

      **===========================================================**
      **   CSR_1 IS THE INITIAL CURSOR TO RETRIEVE THE RPT ROWS.   **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_1 CURSOR FOR
                 SELECT F_RPTID_C
                      , DB_RECTYP_C
                      , A_SEQ_N
                      , F_PRNT_C
                      , F_RPTFMT_C
                      , F_STDRPT_C
                      , F_ELIM_C
                      , F_COLCALC_C
                      , F_ORG_C
                      , F_RGN_C
                      , F_LN_C
                      , F_COL_C
                      , F_RPTID_X
                      , F_PD01_C
                      , F_PD02_C
                      , F_PD03_C
                      , F_PD04_C
                      , F_PD05_C
                      , F_PD06_C
                      , F_PD07_C
                      , F_PD08_C
                      , F_PD09_C
                      , F_PD10_C
                      , F_PD11_C
                      , F_PD12_C
                      , F_PD13_C
                      , F_PD14_C
                   FROM D231.T231RPT
                  WHERE F_RPTID_C  = :DCLT231RPT.F-RPTID-C
                  ORDER BY
                        F_RPTID_C
                      , DB_RECTYP_C
                      , A_SEQ_N
           END-EXEC.

      **===========================================================**
      **   CSR_R1 AND CSR_R2 ARE USED TO RETRIEVE THE REGION ROWS. **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_R1 CURSOR FOR
                 SELECT F_RGN_C
                      , DB_RECTYP_C
                      , F_RGN_X
                   FROM D231.T231RGN
                  WHERE DB_RECTYP_C    = '1'
                    AND F_CMNT_I       = ' '
                    AND F_RGN_C       >= :DCLT231RGN.F-RGN-C
                  ORDER BY
                        F_RGN_C
                      , DB_RECTYP_C
           END-EXEC.

           EXEC SQL
                DECLARE CSR_R2 CURSOR FOR
                 SELECT F_RGN_C
                      , DB_RECTYP_C
                      , F_RGN_X
                   FROM D231.T231RGN
                  WHERE DB_RECTYP_C    = '1'
                    AND F_CMNT_I       = ' '
                    AND F_RGN_C       <= :DCLT231RGN.F-RGN-C
                  ORDER BY
                        F_RGN_C      DESC
                      , DB_RECTYP_C  DESC
           END-EXEC.

      **===========================================================**
      **   CSR_L1 AND CSR_L2 ARE USED TO RETRIEVE THE LINE ROWS.   **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_L1 CURSOR FOR
                 SELECT F_LN_C
                      , F_LN_N
                      , A_SEQ_N
                      , F_LN_X
                      , DB_RECTYP_C
                   FROM D231.T231LINE
                  WHERE F_LN_N          = '  '
                    AND DB_RECTYP_C    IN ('P','R','O')
                    AND F_LN_C         >= :DCLT231LINE.F-LN-C
                  ORDER BY
                        F_LN_C
                      , F_LN_N
                      , A_SEQ_N
           END-EXEC.

           EXEC SQL
                DECLARE CSR_L2 CURSOR FOR
                 SELECT F_LN_C
                      , F_LN_N
                      , A_SEQ_N
                      , F_LN_X
                      , DB_RECTYP_C
                   FROM D231.T231LINE
                  WHERE F_LN_N          = '  '
                    AND DB_RECTYP_C    IN ('P','R','O')
                    AND F_LN_C         <= :DCLT231LINE.F-LN-C
                  ORDER BY
                        F_LN_C   DESC
                      , F_LN_N   DESC
                      , A_SEQ_N  DESC
           END-EXEC.

      **===========================================================**
      **   CSR_C1 AND CSR_C2 ARE USED TO RETRIEVE THE COLUMN ROWS. **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_C1 CURSOR FOR
                 SELECT F_COL_C
                      , DB_RECTYP_C
                      , F_COL_N
                      , F_COL_X
                   FROM D231.T231COL
                  WHERE DB_RECTYP_C    = '1'
                    AND F_COL_C       >= :DCLT231COL.F-COL-C
                  ORDER BY
                        F_COL_C
                      , F_COL_N
                      , DB_RECTYP_C
           END-EXEC.

           EXEC SQL
                DECLARE CSR_C2 CURSOR FOR
                 SELECT F_COL_C
                      , DB_RECTYP_C
                      , F_COL_N
                      , F_COL_X
                   FROM D231.T231COL
                  WHERE DB_RECTYP_C    = '1'
                    AND F_COL_C       <= :DCLT231COL.F-COL-C
                  ORDER BY
                        F_COL_C      DESC
                      , F_COL_N      DESC
                      , DB_RECTYP_C  DESC
           END-EXEC.

      **===========================================================**
      **   CSR_O1 AND CSR_O2 ARE USED TO RETRIEVE THE ORG ROWS.    **
      **===========================================================**

      **===========================================================**
      **   CSR_M1 AND CSR_M2 ARE USED TO RETRIEVE THE MNEMONICS.   **
      **===========================================================**
           EXEC SQL
                DECLARE CSR_M1 CURSOR FOR
                 SELECT F_MNEM_C
                      , F_PDHDG01_C
                      , F_PDHDG02_C
                   FROM D231.T231MNEM
                  WHERE DB_RECTYP_C    = 'V'
                    AND F_MNEM_C      >= :DCLT231MNEM.F-MNEM-C
                  ORDER BY
                        F_MNEM_C
           END-EXEC.

           EXEC SQL
                DECLARE CSR_M2 CURSOR FOR
                 SELECT F_MNEM_C
                      , F_PDHDG01_C
                      , F_PDHDG02_C
                   FROM D231.T231MNEM
                  WHERE DB_RECTYP_C    = 'V'
                    AND F_MNEM_C      <= :DCLT231MNEM.F-MNEM-C
                  ORDER BY
                        F_MNEM_C  DESC
           END-EXEC.

      **===========================================================**
      **   END OF WORKING STORAGE SECTION                          **
      **===========================================================**
           EJECT
       LINKAGE SECTION.

       01  DFHCOMMAREA.
           05  FILLER                   PICTURE X(4096).

           EJECT
       PROCEDURE DIVISION.

           EXEC CICS HANDLE ABEND
                LABEL    (Z900-HANDLE-ERROR)
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR    (Z900-HANDLE-ERROR)
                ILLOGIC  (Z900-HANDLE-ERROR)
                DSIDERR  (Z900-HANDLE-ERROR)
                INVREQ   (Z900-HANDLE-ERROR)
                IOERR    (Z900-HANDLE-ERROR)
                ISCINVREQ(Z900-HANDLE-ERROR)
                NOSPACE  (Z900-HANDLE-ERROR)
           END-EXEC.

       A000-MAINLINE.

           MOVE 'A000'      TO CA-PARAGRAPH-NBR.

           PERFORM A100-INITIALIZATION.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A300-ACCEPT-SCREEN

               EVALUATE TRUE
                   WHEN MAP-1-ACTIVE
                        PERFORM A001-PROCESS-MAP-1
                   WHEN MAP-A-ACTIVE
                        PERFORM A002-PROCESS-MAP-A
               END-EVALUATE
           END-IF.

           PERFORM A200-DISPLAY-SCREEN.

           PERFORM Y100-REPEAT-PROGRAM.

           EJECT
       A001-PROCESS-MAP-1.

           MOVE 'A001'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM B000-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    MOVE CA-CURRENT-PGM TO CA-RETURN-PGM
                    MOVE CA-PREV-TXN    TO W0001-TXN-ID
                    PERFORM Y700-START-TRANSACTION
               WHEN EIBAID = DFHPF5
                    IF  CA-CORPORATE-USER
                        PERFORM D000-UPDATE-CURRENT-REPORT
                    ELSE
                        MOVE -1             TO M-RPTID-XL
                        SET ERRORS          TO TRUE
                        MOVE W9999-MSG-015  TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF6
                    IF  CA-CORPORATE-USER
                        PERFORM E000-INSERT-REPORT-LINES
                    ELSE
                        MOVE -1             TO M-RPTID-XL
                        SET ERRORS          TO TRUE
                        MOVE W9999-MSG-015  TO M-MSG-22I
                    END-IF
               WHEN EIBAID = DFHPF7
                    SET MAP-A-ACTIVE      TO TRUE
                    SET DISPLAY-ORGS      TO TRUE
                    PERFORM F000-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHPF8
                    SET MAP-A-ACTIVE      TO TRUE
                    SET DISPLAY-REGIONS   TO TRUE
                    PERFORM F000-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHPF9
                    SET MAP-A-ACTIVE      TO TRUE
                    SET DISPLAY-LINES     TO TRUE
                    PERFORM F000-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHPF10
                    SET MAP-A-ACTIVE      TO TRUE
                    SET DISPLAY-COLUMNS   TO TRUE
                    PERFORM F000-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHPF11
                    SET MAP-A-ACTIVE      TO TRUE
                    SET DISPLAY-MNEMONICS TO TRUE
                    PERFORM F000-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHPF12
                    MOVE CA-CURRENT-PGM TO CA-RETURN-PGM
                    MOVE CA-PREV-TXN    TO W0001-TXN-ID
                    PERFORM Y700-START-TRANSACTION
               WHEN OTHER
                    MOVE -1             TO M-RPTID-XL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22I
           END-EVALUATE.

           EJECT
       A002-PROCESS-MAP-A.

           MOVE 'A002'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN EIBAID = DFHENTER
                    PERFORM F000-PROCESS-ENTER-KEY
               WHEN EIBAID = DFHCLEAR
                    PERFORM Y400-RETURN-TO-CICS
               WHEN EIBAID = DFHPF3
                    SET MAP-1-ACTIVE    TO TRUE
                    PERFORM B300-DISPLAY-SCREEN-1
               WHEN EIBAID = DFHPF7
                    PERFORM G000-PROCESS-PREV-PAGE
               WHEN EIBAID = DFHPF8
                    PERFORM H000-PROCESS-NEXT-PAGE
               WHEN EIBAID = DFHPF12
                    SET MAP-1-ACTIVE    TO TRUE
                    PERFORM B300-DISPLAY-SCREEN-1
               WHEN OTHER
                    MOVE -1             TO M-KEY-CL
                    SET ERRORS          TO TRUE
                    MOVE W9999-MSG-002  TO M-MSG-22AI
           END-EVALUATE.

           EJECT
       A100-INITIALIZATION.

           MOVE 'A100'      TO CA-PARAGRAPH-NBR.

           IF  EIBCALEN NOT EQUAL ZEROES
               MOVE DFHCOMMAREA TO WS-COMMAREA
               IF  CA-CURRENT-PGM = PROGRAM-NAME
                   CONTINUE
               ELSE
                   MOVE CA-CURRENT-PGM TO CA-PREV-PGM
                   MOVE CA-CURRENT-TXN TO CA-PREV-TXN
                   PERFORM A150-SETUP-COMMAREA
               END-IF
           ELSE
               MOVE MAIN-MENU-TXN-ID  TO W0001-TXN-ID
               PERFORM Y600-START-TRANSACTION
           END-IF.

           EJECT
       A150-SETUP-COMMAREA.

           MOVE 'A150'      TO CA-PARAGRAPH-NBR.

           EXEC CICS ASKTIME
                ABSTIME (W0001-ABSTIME)
           END-EXEC.

           EXEC CICS FORMATTIME
                ABSTIME (W0001-ABSTIME)
                TIME    (W0001-HHCMMCSS)
                TIMESEP
                MMDDYY  (W0001-MMSDDSYY)
                DATESEP
                YEAR    (W0001-YYYY)
           END-EXEC.

           MOVE W0001-MMSDDSYY    TO M-DATEI
                                     CA-DATE.
           MOVE W0001-HHCMMCSS    TO M-TIMEI
                                     CA-TIME.

           EJECT
       A200-DISPLAY-SCREEN.

           MOVE 'A200'      TO CA-PARAGRAPH-NBR.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A210-SAVE-MAP
           ELSE
               INITIALIZE  MAP-SAVE-AREA
               INITIALIZE  M231F05I
               INITIALIZE  M231F5AI
               MOVE CA-CURR-F-RPTID-C TO M-RPTID-CI
               MOVE CA-CURR-F-RPTID-X TO M-RPTID-XI
               SET MAP-1-ACTIVE TO TRUE
               MOVE MAP-NAME-1  TO MAP-NAME
               MOVE -1          TO M-RPTID-XL
               PERFORM C000-PROCESS-INITIAL-CURSOR
           END-IF.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    PERFORM A220-SET-SCREEN-1-ATTRIBUTES
                    MOVE MAP-NAME-1 TO MAP-NAME
                    MOVE M231F05I   TO MAP-DATA
               WHEN MAP-A-ACTIVE
                    PERFORM A221-SET-SCREEN-A-ATTRIBUTES
                    MOVE MAP-NAME-A TO MAP-NAME
                    MOVE M231F5AI   TO MAP-DATA
           END-EVALUATE.

           EXEC CICS HANDLE CONDITION
                MAPFAIL (Z100-MAPFAIL)
                ERROR   (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS SEND
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                FROM   (MAP-DATA)
                ERASE
                CURSOR
           END-EXEC.

           EJECT
       A210-SAVE-MAP.

           MOVE 'A210'      TO CA-PARAGRAPH-NBR.

           EJECT
       A220-SET-SCREEN-1-ATTRIBUTES.

           MOVE 'A220'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CA
                M-FYPDA
                M-DATEA
                M-TIMEA
                M-MSG-22A.

           IF  CA-CORPORATE-USER
               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-RPTID-CA
           ELSE
               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-RPTID-CA
           END-IF.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-RPTID-XA
                M-ELIM-CA
                M-PGBRK-CA
                M-RPTFMT-CA
                M-STDRPT-CA
                M-COLCALC-CA
                M-ORG-CA
                M-RGN-CA
                M-LN-CA
                M-COL-CA
                M-PRNT-C1A
                M-P1C01-CA
                M-P1C02-CA
                M-P1C03-CA
                M-P1C04-CA
                M-P1C05-CA
                M-P1C06-CA
                M-P1C07-CA
                M-P1C08-CA
                M-P1C09-CA
                M-P1C10-CA
                M-P1C11-CA
                M-PRNT-C2A
                M-P2C01-CA
                M-P2C02-CA
                M-P2C03-CA
                M-P2C04-CA
                M-P2C05-CA
                M-P2C06-CA
                M-P2C07-CA
                M-P2C08-CA
                M-P2C09-CA
                M-P2C10-CA
                M-P2C11-CA
                M-HDG1-XA
                M-HDG2-XA
                M-HDG3-X1A
                M-HDG3-X2A
                M-CMNT-XA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > 4

               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-LINEA    (W0001-X)

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-PRNT-C3A (W0001-X)
                    M-PD01-CA  (W0001-X)
                    M-PD02-CA  (W0001-X)
                    M-PD03-CA  (W0001-X)
                    M-PD04-CA  (W0001-X)
                    M-PD05-CA  (W0001-X)
                    M-PD06-CA  (W0001-X)
                    M-PD07-CA  (W0001-X)
                    M-PD08-CA  (W0001-X)
                    M-PD09-CA  (W0001-X)
                    M-PD10-CA  (W0001-X)
                    M-PD11-CA  (W0001-X)
                    M-PD12-CA  (W0001-X)
                    M-PD13-CA  (W0001-X)
                    M-PD14-CA  (W0001-X)

               MOVE M-PRNT-C3I (W0001-X)  TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PRNT-C3I (W0001-X)

               MOVE M-PD01-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD01-CI (W0001-X)

               MOVE M-PD02-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD02-CI (W0001-X)

               MOVE M-PD03-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD03-CI (W0001-X)

               MOVE M-PD04-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD04-CI (W0001-X)

               MOVE M-PD05-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD05-CI (W0001-X)

               MOVE M-PD06-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD06-CI (W0001-X)

               MOVE M-PD07-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD07-CI (W0001-X)

               MOVE M-PD08-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD08-CI (W0001-X)

               MOVE M-PD09-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD09-CI (W0001-X)

               MOVE M-PD10-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD10-CI (W0001-X)

               MOVE M-PD11-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD11-CI (W0001-X)

               MOVE M-PD12-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD12-CI (W0001-X)

               MOVE M-PD13-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD13-CI (W0001-X)

               MOVE M-PD14-CI (W0001-X)   TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA            TO M-PD14-CI (W0001-X)
           END-PERFORM.

           MOVE M-RPTID-XI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPTID-XI.

           MOVE M-RPTFMT-CI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RPTFMT-CI.

           MOVE M-STDRPT-CI    TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-STDRPT-CI.

           MOVE M-ELIM-CI      TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-ELIM-CI.

           MOVE M-PGBRK-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-PGBRK-CI.

           MOVE M-COLCALC-CI   TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-COLCALC-CI.

           MOVE M-ORG-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-ORG-CI.

           MOVE M-RGN-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-RGN-CI.

           MOVE M-LN-CI        TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-LN-CI.

           MOVE M-COL-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-COL-CI.

           MOVE M-PRNT-C1I     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-PRNT-C1I.

           MOVE M-P1C01-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C01-CI.

           MOVE M-P1C02-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C02-CI.

           MOVE M-P1C03-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C03-CI.

           MOVE M-P1C04-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C04-CI.

           MOVE M-P1C05-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C05-CI.

           MOVE M-P1C06-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C06-CI.

           MOVE M-P1C07-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C07-CI.

           MOVE M-P1C08-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C08-CI.

           MOVE M-P1C09-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C09-CI.

           MOVE M-P1C10-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C10-CI.

           MOVE M-P1C11-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P1C11-CI.

           MOVE M-PRNT-C2I     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-PRNT-C2I.

           MOVE M-P2C01-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C01-CI.

           MOVE M-P2C02-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C02-CI.

           MOVE M-P2C03-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C03-CI.

           MOVE M-P2C04-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C04-CI.

           MOVE M-P2C05-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C05-CI.

           MOVE M-P2C06-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C06-CI.

           MOVE M-P2C07-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C07-CI.

           MOVE M-P2C08-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C08-CI.

           MOVE M-P2C09-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C09-CI.

           MOVE M-P2C10-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C10-CI.

           MOVE M-P2C11-CI     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-P2C11-CI.

           MOVE M-HDG1-XI      TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-HDG1-XI.

           MOVE M-HDG2-XI      TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-HDG2-XI.

           MOVE M-HDG3-X1I     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-HDG3-X1I.

           MOVE M-HDG3-X2I     TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-HDG3-X2I.

           MOVE M-CMNT-XI      TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-CMNT-XI.

           MOVE CA-OP-ID       TO M-UID-CI.
           MOVE CA-FYPD        TO M-FYPDI.
           MOVE CA-DATE        TO M-DATEI.
           MOVE CA-TIME        TO M-TIMEI.

           EJECT
       A221-SET-SCREEN-A-ATTRIBUTES.

           MOVE 'A221'      TO CA-PARAGRAPH-NBR.

           MOVE ATTR-ALPHA-PROT-BRT-PEN
             TO M-UID-CAA
                M-FYPDAA
                M-DATEAA
                M-TIMEAA
                M-MSG-22AA
                M-HDG-1A
                M-HDG-2A
                M-DESC-XA.

           MOVE ATTR-ALPHA-UNPROT-MDT
             TO M-KEY-CA.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT

               MOVE ATTR-ALPHA-UNPROT-MDT
                 TO M-ACT-CA        (W0001-X)

               MOVE ATTR-ALPHA-PROT-MDT
                 TO M-DATA-XA       (W0001-X)

               IF  M-DATA-XI (W0001-X) EQUAL SPACES
                   MOVE ATTR-ALPHA-PROT-MDT
                     TO M-ACT-CA    (W0001-X)
                   MOVE SPACES
                     TO M-ACT-CI (W0001-X)
               ELSE
                   MOVE M-ACT-CI (W0001-X) TO W9998-DATA
                   PERFORM Z998-MOVE-UNDERSCORES
                   MOVE W9998-DATA  TO M-ACT-CI (W0001-X)
               END-IF
           END-PERFORM.

           MOVE M-KEY-CI       TO W9998-DATA.
           PERFORM Z998-MOVE-UNDERSCORES.
           MOVE W9998-DATA     TO M-KEY-CI.

           EVALUATE TRUE
               WHEN DISPLAY-REGIONS
                    MOVE W0001-RGN-DESC   TO M-DESC-XI
                    MOVE W0001-RGN-HDG-1  TO M-HDG-1I
                    MOVE W0001-RGN-HDG-2  TO M-HDG-2I
               WHEN DISPLAY-LINES
                    MOVE W0001-LINE-DESC  TO M-DESC-XI
                    MOVE W0001-LINE-HDG-1 TO M-HDG-1I
                    MOVE W0001-LINE-HDG-2 TO M-HDG-2I
               WHEN DISPLAY-COLUMNS
                    MOVE W0001-COL-DESC   TO M-DESC-XI
                    MOVE W0001-COL-HDG-1  TO M-HDG-1I
                    MOVE W0001-COL-HDG-2  TO M-HDG-2I
               WHEN DISPLAY-ORGS
                    MOVE W0001-ORG-DESC   TO M-DESC-XI
                    MOVE W0001-ORG-HDG-1  TO M-HDG-1I
                    MOVE W0001-ORG-HDG-2  TO M-HDG-2I
               WHEN DISPLAY-MNEMONICS
                    MOVE W0001-MNEM-DESC  TO M-DESC-XI
                    MOVE W0001-MNEM-HDG-1 TO M-HDG-1I
                    MOVE W0001-MNEM-HDG-2 TO M-HDG-2I
           END-EVALUATE.

           MOVE CA-OP-ID       TO M-UID-CAI.
           MOVE CA-FYPD        TO M-FYPDAI.
           MOVE CA-DATE        TO M-DATEAI.
           MOVE CA-TIME        TO M-TIMEAI.

           MOVE M-RPTID-CI     TO CA-CURR-F-RPTID-C.
           MOVE M-RPTID-XI     TO CA-CURR-F-RPTID-X.

           EJECT
       A300-ACCEPT-SCREEN.

           MOVE 'A300'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    MOVE MAP-NAME-1 TO MAP-NAME
               WHEN MAP-A-ACTIVE
                    MOVE MAP-NAME-A TO MAP-NAME
           END-EVALUATE.

           EXEC CICS IGNORE CONDITION
                MAPFAIL
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS RECEIVE
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                INTO   (MAP-DATA)
           END-EXEC.

           EVALUATE TRUE
               WHEN MAP-1-ACTIVE
                    MOVE MAP-DATA TO M231F05I
                    PERFORM A310-PROCESS-MAP-1-FIELDS
               WHEN MAP-A-ACTIVE
                    MOVE MAP-DATA TO M231F5AI
                    PERFORM A311-PROCESS-MAP-A-FIELDS
           END-EVALUATE.

           EJECT
       A310-PROCESS-MAP-1-FIELDS.

           MOVE 'A310'      TO CA-PARAGRAPH-NBR.

           INSPECT M-RPTID-XI      REPLACING ALL '_' BY ' '.
           INSPECT M-ELIM-CI       REPLACING ALL '_' BY ' '.
           INSPECT M-PGBRK-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-RPTFMT-CI     REPLACING ALL '_' BY ' '.
           INSPECT M-STDRPT-CI     REPLACING ALL '_' BY ' '.
           INSPECT M-COLCALC-CI    REPLACING ALL '_' BY ' '.
           INSPECT M-ORG-CI        REPLACING ALL '_' BY ' '.
           INSPECT M-RGN-CI        REPLACING ALL '_' BY ' '.
           INSPECT M-LN-CI         REPLACING ALL '_' BY ' '.
           INSPECT M-COL-CI        REPLACING ALL '_' BY ' '.
           INSPECT M-PRNT-C1I      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C01-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C02-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C03-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C04-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C05-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C06-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C07-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C08-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C09-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C10-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P1C11-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-PRNT-C2I      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C01-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C02-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C03-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C04-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C05-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C06-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C07-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C08-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C09-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C10-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-P2C11-CI      REPLACING ALL '_' BY ' '.
           INSPECT M-HDG1-XI       REPLACING ALL '_' BY ' '.
           INSPECT M-HDG2-XI       REPLACING ALL '_' BY ' '.
           INSPECT M-HDG3-X1I      REPLACING ALL '_' BY ' '.
           INSPECT M-HDG3-X2I      REPLACING ALL '_' BY ' '.
           INSPECT M-CMNT-XI       REPLACING ALL '_' BY ' '.

           INSPECT M-RPTID-XI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-ELIM-CI       REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-PGBRK-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RPTFMT-CI     REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-STDRPT-CI     REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-COLCALC-CI    REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-ORG-CI        REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-RGN-CI        REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-LN-CI         REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-COL-CI        REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-PRNT-C1I      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C01-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C02-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C03-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C04-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C05-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C06-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C07-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C08-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C09-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C10-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P1C11-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-PRNT-C2I      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C01-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C02-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C03-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C04-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C05-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C06-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C07-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C08-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C09-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C10-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-P2C11-CI      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-HDG1-XI       REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-HDG2-XI       REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-HDG3-X1I      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-HDG3-X2I      REPLACING ALL LOW-VALUES BY ' '.
           INSPECT M-CMNT-XI       REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > 4

               INSPECT M-PRNT-C3I (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD01-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD02-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD03-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD04-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD05-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD06-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD07-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD08-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD09-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD10-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD11-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD12-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD13-CI  (W0001-X) REPLACING ALL '_' BY ' '
               INSPECT M-PD14-CI  (W0001-X) REPLACING ALL '_' BY ' '

               INSPECT M-PRNT-C3I (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD01-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD02-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD03-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD04-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD05-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD06-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD07-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD08-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD09-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD10-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD11-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD12-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD13-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
               INSPECT M-PD14-CI  (W0001-X)
                  REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       A311-PROCESS-MAP-A-FIELDS.

           MOVE 'A311'      TO CA-PARAGRAPH-NBR.

           INSPECT M-KEY-CI REPLACING ALL '_' BY ' '.

           INSPECT M-KEY-CI REPLACING ALL LOW-VALUES BY ' '.

           PERFORM VARYING W0001-X FROM 1 BY 1
             UNTIL W0001-X > W0001-SCREEN-A-LN-LIMIT
                   INSPECT M-ACT-CI (W0001-X) REPLACING ALL '_' BY ' '
                   INSPECT M-ACT-CI (W0001-X)
                       REPLACING ALL LOW-VALUES BY ' '
           END-PERFORM.

           EJECT
       B000-PROCESS-ENTER-KEY.

           MOVE 'B000'      TO CA-PARAGRAPH-NBR.

           IF  M-RPTID-CI EQUAL WS-M-F-RPTID-C (1)
               PERFORM B100-VALIDATE-FIELDS
               IF  NO-ERRORS
                   MOVE W9999-MSG-019  TO M-MSG-22I
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-RPTID-XL
               END-IF
           ELSE
               MOVE M-RPTID-CI         TO WS-M-F-RPTID-C (1)
               INITIALIZE M231F05I
               MOVE WS-M-F-RPTID-C (1) TO M-RPTID-CI
               PERFORM C000-PROCESS-INITIAL-CURSOR
               IF  WS-M-F-RPTID-C (2) EQUAL SPACES
                   MOVE W9999-MSG-023  TO M-MSG-22I
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-RPTID-XL
               END-IF
           END-IF.

           EJECT
       B100-VALIDATE-FIELDS.

           MOVE 'B100'      TO CA-PARAGRAPH-NBR.

           EJECT
       B300-DISPLAY-SCREEN-1.

           MOVE 'B300'      TO CA-PARAGRAPH-NBR.

           PERFORM VARYING W0001-IX FROM 1 BY 1
                     UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT

               PERFORM B310-MOVE-MAP-TO-DB

               EVALUATE TRUE
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '/'
                        PERFORM B320-BUILD-COMMENT-REC
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '1'
                        PERFORM C212-BUILD-REC-TYPE-1
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '2'
                        PERFORM C213-BUILD-REC-TYPE-2
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '3'
                        PERFORM C214-BUILD-REC-TYPE-3
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '4'
                        PERFORM C215-BUILD-REC-TYPE-4
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '5'
                        PERFORM C216-BUILD-REC-TYPE-5
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '6'
                        PERFORM C217-BUILD-REC-TYPE-6
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '7'
                        PERFORM C218-BUILD-REC-TYPE-7
                   WHEN DB-RECTYP-C  IN DCLT231RPT    = '8'
                        PERFORM C219-BUILD-REC-TYPE-8
               END-EVALUATE
           END-PERFORM.

           IF  NO-ERRORS
               MOVE W9999-MSG-019  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-RPTID-XL
           END-IF.

           EJECT
       B310-MOVE-MAP-TO-DB.

           MOVE 'B310'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-F-RPTID-C    (W0001-IX)
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE WS-M-DB-RECTYP-C  (W0001-IX)
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE WS-M-A-SEQ-N      (W0001-IX)
             TO A-SEQ-N           IN DCLT231RPT.
           MOVE WS-M-F-PRNT-C     (W0001-IX)
             TO F-PRNT-C          IN DCLT231RPT.
           MOVE WS-M-F-RPTFMT-C   (W0001-IX)
             TO F-RPTFMT-C        IN DCLT231RPT.
           MOVE WS-M-F-STDRPT-C   (W0001-IX)
             TO F-STDRPT-C        IN DCLT231RPT.
           MOVE WS-M-F-ELIM-C     (W0001-IX)
             TO F-ELIM-C          IN DCLT231RPT.
           MOVE WS-M-F-COLCALC-C  (W0001-IX)
             TO F-COLCALC-C       IN DCLT231RPT.
           MOVE WS-M-F-ORG-C      (W0001-IX)
             TO F-ORG-C           IN DCLT231RPT.
           MOVE WS-M-F-RGN-C      (W0001-IX)
             TO F-RGN-C           IN DCLT231RPT.
           MOVE WS-M-F-LN-C       (W0001-IX)
             TO F-LN-C            IN DCLT231RPT.
           MOVE WS-M-F-COL-C      (W0001-IX)
             TO F-COL-C           IN DCLT231RPT.
           MOVE WS-M-F-RPTID-X    (W0001-IX)
             TO F-RPTID-X         IN DCLT231RPT.

           MOVE WS-M-F-PD01-C     (W0001-IX)
             TO F-PD01-C          IN DCLT231RPT.
           MOVE WS-M-F-PD02-C     (W0001-IX)
             TO F-PD02-C          IN DCLT231RPT.
           MOVE WS-M-F-PD03-C     (W0001-IX)
             TO F-PD03-C          IN DCLT231RPT.
           MOVE WS-M-F-PD04-C     (W0001-IX)
             TO F-PD04-C          IN DCLT231RPT.
           MOVE WS-M-F-PD05-C     (W0001-IX)
             TO F-PD05-C          IN DCLT231RPT.
           MOVE WS-M-F-PD06-C     (W0001-IX)
             TO F-PD06-C          IN DCLT231RPT.
           MOVE WS-M-F-PD07-C     (W0001-IX)
             TO F-PD07-C          IN DCLT231RPT.
           MOVE WS-M-F-PD08-C     (W0001-IX)
             TO F-PD08-C          IN DCLT231RPT.
           MOVE WS-M-F-PD09-C     (W0001-IX)
             TO F-PD09-C          IN DCLT231RPT.
           MOVE WS-M-F-PD10-C     (W0001-IX)
             TO F-PD10-C          IN DCLT231RPT.
           MOVE WS-M-F-PD11-C     (W0001-IX)
             TO F-PD11-C          IN DCLT231RPT.
           MOVE WS-M-F-PD12-C     (W0001-IX)
             TO F-PD12-C          IN DCLT231RPT.
           MOVE WS-M-F-PD13-C     (W0001-IX)
             TO F-PD13-C          IN DCLT231RPT.
           MOVE WS-M-F-PD14-C     (W0001-IX)
             TO F-PD14-C          IN DCLT231RPT.

           EJECT
       B320-BUILD-COMMENT-REC.

           MOVE 'B320'      TO CA-PARAGRAPH-NBR.

           MOVE +1      TO W0001-IX.

           EVALUATE TRUE
               WHEN A-SEQ-N  IN DCLT231RPT = +1
                    MOVE F-RPTID-X  IN DCLT231RPT
                      TO M-CMNT-XI
           END-EVALUATE.

           EJECT
       C000-PROCESS-INITIAL-CURSOR.

           MOVE 'C000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM C200-GET-T231RPT
           END-IF.

           EJECT
       C200-GET-T231RPT.

           MOVE 'C200'      TO CA-PARAGRAPH-NBR.

           MOVE M-RPTID-CI   TO F-RPTID-C   IN DCLT231RPT.

           EXEC SQL
                OPEN CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           PERFORM VARYING W0001-IX FROM 1 BY 1
                     UNTIL W0001-IX > W0001-SCREEN-LINE-LIMIT
               INITIALIZE WS-M-DB-SAVE (W0001-IX)
           END-PERFORM.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
               EXEC SQL
                    FETCH CSR_1
                     INTO :DCLT231RPT.F-RPTID-C
                        , :DCLT231RPT.DB-RECTYP-C
                        , :DCLT231RPT.A-SEQ-N
                        , :DCLT231RPT.F-PRNT-C
                        , :DCLT231RPT.F-RPTFMT-C
                        , :DCLT231RPT.F-STDRPT-C
                        , :DCLT231RPT.F-ELIM-C
                        , :DCLT231RPT.F-COLCALC-C
                        , :DCLT231RPT.F-ORG-C
                        , :DCLT231RPT.F-RGN-C
                        , :DCLT231RPT.F-LN-C
                        , :DCLT231RPT.F-COL-C
                        , :DCLT231RPT.F-RPTID-X
                        , :DCLT231RPT.F-PD01-C
                        , :DCLT231RPT.F-PD02-C
                        , :DCLT231RPT.F-PD03-C
                        , :DCLT231RPT.F-PD04-C
                        , :DCLT231RPT.F-PD05-C
                        , :DCLT231RPT.F-PD06-C
                        , :DCLT231RPT.F-PD07-C
                        , :DCLT231RPT.F-PD08-C
                        , :DCLT231RPT.F-PD09-C
                        , :DCLT231RPT.F-PD10-C
                        , :DCLT231RPT.F-PD11-C
                        , :DCLT231RPT.F-PD12-C
                        , :DCLT231RPT.F-PD13-C
                        , :DCLT231RPT.F-PD14-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   EVALUATE TRUE
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '/'
                            PERFORM C211-BUILD-COMMENT-REC
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '1'
                            PERFORM C212-BUILD-REC-TYPE-1
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '2'
                            PERFORM C213-BUILD-REC-TYPE-2
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '3'
                            PERFORM C214-BUILD-REC-TYPE-3
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '4'
                            PERFORM C215-BUILD-REC-TYPE-4
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '5'
                            PERFORM C216-BUILD-REC-TYPE-5
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '6'
                            PERFORM C217-BUILD-REC-TYPE-6
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '7'
                            PERFORM C218-BUILD-REC-TYPE-7
                       WHEN DB-RECTYP-C  IN DCLT231RPT    = '8'
                            PERFORM C219-BUILD-REC-TYPE-8
                   END-EVALUATE

                   PERFORM C210-SAVE-DB-TO-MAP
               END-IF
           END-PERFORM.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-003  TO M-MSG-22I
               SET ERRORS          TO TRUE
               MOVE -1             TO M-RPTID-XL
           END-IF.

           EXEC SQL
               CLOSE CSR_1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  NO-ERRORS
               MOVE W9999-MSG-019  TO M-MSG-22I
               MOVE -1             TO M-RPTID-XL
           END-IF.

           EJECT
       C210-SAVE-DB-TO-MAP.

           MOVE 'C210'      TO CA-PARAGRAPH-NBR.

           MOVE F-RPTID-C         IN DCLT231RPT
             TO WS-M-F-RPTID-C    (W0001-IX).
           MOVE DB-RECTYP-C       IN DCLT231RPT
             TO WS-M-DB-RECTYP-C  (W0001-IX).
           MOVE A-SEQ-N           IN DCLT231RPT
             TO WS-M-A-SEQ-N      (W0001-IX).
           MOVE F-PRNT-C          IN DCLT231RPT
             TO WS-M-F-PRNT-C     (W0001-IX).
           MOVE F-RPTFMT-C        IN DCLT231RPT
             TO WS-M-F-RPTFMT-C   (W0001-IX).
           MOVE F-STDRPT-C        IN DCLT231RPT
             TO WS-M-F-STDRPT-C   (W0001-IX).
           MOVE F-ELIM-C          IN DCLT231RPT
             TO WS-M-F-ELIM-C     (W0001-IX).
           MOVE F-COLCALC-C       IN DCLT231RPT
             TO WS-M-F-COLCALC-C  (W0001-IX).
           MOVE F-ORG-C           IN DCLT231RPT
             TO WS-M-F-ORG-C      (W0001-IX).
           MOVE F-RGN-C           IN DCLT231RPT
             TO WS-M-F-RGN-C      (W0001-IX).
           MOVE F-LN-C            IN DCLT231RPT
             TO WS-M-F-LN-C       (W0001-IX).
           MOVE F-COL-C           IN DCLT231RPT
             TO WS-M-F-COL-C      (W0001-IX).
           MOVE F-RPTID-X         IN DCLT231RPT
             TO WS-M-F-RPTID-X    (W0001-IX).

           MOVE F-PD01-C          IN DCLT231RPT
             TO WS-M-F-PD01-C     (W0001-IX).
           MOVE F-PD02-C          IN DCLT231RPT
             TO WS-M-F-PD02-C     (W0001-IX).
           MOVE F-PD03-C          IN DCLT231RPT
             TO WS-M-F-PD03-C     (W0001-IX).
           MOVE F-PD04-C          IN DCLT231RPT
             TO WS-M-F-PD04-C     (W0001-IX).
           MOVE F-PD05-C          IN DCLT231RPT
             TO WS-M-F-PD05-C     (W0001-IX).
           MOVE F-PD06-C          IN DCLT231RPT
             TO WS-M-F-PD06-C     (W0001-IX).
           MOVE F-PD07-C          IN DCLT231RPT
             TO WS-M-F-PD07-C     (W0001-IX).
           MOVE F-PD08-C          IN DCLT231RPT
             TO WS-M-F-PD08-C     (W0001-IX).
           MOVE F-PD09-C          IN DCLT231RPT
             TO WS-M-F-PD09-C     (W0001-IX).
           MOVE F-PD10-C          IN DCLT231RPT
             TO WS-M-F-PD10-C     (W0001-IX).
           MOVE F-PD11-C          IN DCLT231RPT
             TO WS-M-F-PD11-C     (W0001-IX).
           MOVE F-PD12-C          IN DCLT231RPT
             TO WS-M-F-PD12-C     (W0001-IX).
           MOVE F-PD13-C          IN DCLT231RPT
             TO WS-M-F-PD13-C     (W0001-IX).
           MOVE F-PD14-C          IN DCLT231RPT
             TO WS-M-F-PD14-C     (W0001-IX).

           EJECT
       C211-BUILD-COMMENT-REC.

           MOVE 'C211'      TO CA-PARAGRAPH-NBR.

           MOVE +1      TO W0001-IX.

           EVALUATE TRUE
               WHEN A-SEQ-N  IN DCLT231RPT = +1
                    MOVE F-RPTID-X  IN DCLT231RPT
                      TO M-CMNT-XI
           END-EVALUATE.

           EJECT
       C212-BUILD-REC-TYPE-1.

           MOVE 'C212'      TO CA-PARAGRAPH-NBR.

           MOVE +2      TO W0001-IX.

           MOVE F-RPTID-C         IN DCLT231RPT
             TO M-RPTID-CI.
           MOVE F-PRNT-C          IN DCLT231RPT
             TO M-PGBRK-CI.
           MOVE F-RPTFMT-C        IN DCLT231RPT
             TO M-RPTFMT-CI.
           MOVE F-STDRPT-C        IN DCLT231RPT
             TO M-STDRPT-CI.
           MOVE F-ELIM-C          IN DCLT231RPT
             TO M-ELIM-CI.
           MOVE F-COLCALC-C       IN DCLT231RPT
             TO M-COLCALC-CI.
           MOVE F-ORG-C           IN DCLT231RPT
             TO M-ORG-CI.
           MOVE F-RGN-C           IN DCLT231RPT
             TO M-RGN-CI.
           MOVE F-LN-C            IN DCLT231RPT
             TO M-LN-CI.
           MOVE F-COL-C           IN DCLT231RPT
             TO M-COL-CI.
           MOVE F-RPTID-X         IN DCLT231RPT
             TO M-RPTID-XI.

           EJECT
       C213-BUILD-REC-TYPE-2.

           MOVE 'C213'      TO CA-PARAGRAPH-NBR.

           MOVE +3      TO W0001-IX.

           MOVE F-RPTFMT-C        IN DCLT231RPT
             TO M-PRNT-C1I.
           MOVE F-PD01-C          IN DCLT231RPT
             TO M-P1C01-CI.
           MOVE F-PD02-C          IN DCLT231RPT
             TO M-P1C02-CI.
           MOVE F-PD03-C          IN DCLT231RPT
             TO M-P1C03-CI.
           MOVE F-PD04-C          IN DCLT231RPT
             TO M-P1C04-CI.
           MOVE F-PD05-C          IN DCLT231RPT
             TO M-P1C05-CI.
           MOVE F-PD06-C          IN DCLT231RPT
             TO M-P1C06-CI.
           MOVE F-PD07-C          IN DCLT231RPT
             TO M-P1C07-CI.
           MOVE F-PD08-C          IN DCLT231RPT
             TO M-P1C08-CI.
           MOVE F-PD09-C          IN DCLT231RPT
             TO M-P1C09-CI.
           MOVE F-PD10-C          IN DCLT231RPT
             TO M-P1C10-CI.
           MOVE F-PD11-C          IN DCLT231RPT
             TO M-P1C11-CI.

           EJECT
       C214-BUILD-REC-TYPE-3.

           MOVE 'C214'      TO CA-PARAGRAPH-NBR.

           MOVE +4      TO W0001-IX.

           MOVE F-RPTFMT-C        IN DCLT231RPT
             TO M-PRNT-C2I.
           MOVE F-PD01-C          IN DCLT231RPT
             TO M-P2C01-CI.
           MOVE F-PD02-C          IN DCLT231RPT
             TO M-P2C02-CI.
           MOVE F-PD03-C          IN DCLT231RPT
             TO M-P2C03-CI.
           MOVE F-PD04-C          IN DCLT231RPT
             TO M-P2C04-CI.
           MOVE F-PD05-C          IN DCLT231RPT
             TO M-P2C05-CI.
           MOVE F-PD06-C          IN DCLT231RPT
             TO M-P2C06-CI.
           MOVE F-PD07-C          IN DCLT231RPT
             TO M-P2C07-CI.
           MOVE F-PD08-C          IN DCLT231RPT
             TO M-P2C08-CI.
           MOVE F-PD09-C          IN DCLT231RPT
             TO M-P2C09-CI.
           MOVE F-PD10-C          IN DCLT231RPT
             TO M-P2C10-CI.
           MOVE F-PD11-C          IN DCLT231RPT
             TO M-P2C11-CI.

           EJECT
       C215-BUILD-REC-TYPE-4.

           MOVE 'C215'      TO CA-PARAGRAPH-NBR.

           EVALUATE TRUE
               WHEN A-SEQ-N  IN DCLT231RPT = +1
                    MOVE +1  TO W0001-X
                    MOVE +5  TO W0001-IX
               WHEN A-SEQ-N  IN DCLT231RPT = +2
                    MOVE +2  TO W0001-X
                    MOVE +6  TO W0001-IX
               WHEN A-SEQ-N  IN DCLT231RPT = +3
                    MOVE +3  TO W0001-X
                    MOVE +7  TO W0001-IX
               WHEN A-SEQ-N  IN DCLT231RPT = +4
                    MOVE +4  TO W0001-X
                    MOVE +8  TO W0001-IX
           END-EVALUATE.

           MOVE F-RPTFMT-C   IN DCLT231RPT
             TO M-PRNT-C3I   (W0001-X).
           MOVE F-PD01-C     IN DCLT231RPT
             TO M-PD01-CI    (W0001-X).
           MOVE F-PD02-C     IN DCLT231RPT
             TO M-PD02-CI    (W0001-X).
           MOVE F-PD03-C     IN DCLT231RPT
             TO M-PD03-CI    (W0001-X).
           MOVE F-PD04-C     IN DCLT231RPT
             TO M-PD04-CI    (W0001-X).
           MOVE F-PD05-C     IN DCLT231RPT
             TO M-PD05-CI    (W0001-X).
           MOVE F-PD06-C     IN DCLT231RPT
             TO M-PD06-CI    (W0001-X).
           MOVE F-PD07-C     IN DCLT231RPT
             TO M-PD07-CI    (W0001-X).
           MOVE F-PD08-C     IN DCLT231RPT
             TO M-PD08-CI    (W0001-X).
           MOVE F-PD09-C     IN DCLT231RPT
             TO M-PD09-CI    (W0001-X).
           MOVE F-PD10-C     IN DCLT231RPT
             TO M-PD10-CI    (W0001-X).
           MOVE F-PD11-C     IN DCLT231RPT
             TO M-PD11-CI    (W0001-X).
           MOVE F-PD12-C     IN DCLT231RPT
             TO M-PD12-CI    (W0001-X).
           MOVE F-PD13-C     IN DCLT231RPT
             TO M-PD13-CI    (W0001-X).
           MOVE F-PD14-C     IN DCLT231RPT
             TO M-PD14-CI    (W0001-X).

           EJECT
       C216-BUILD-REC-TYPE-5.

           MOVE 'C216'      TO CA-PARAGRAPH-NBR.

           MOVE +9      TO W0001-IX.

           MOVE F-RPTID-X         IN DCLT231RPT
             TO M-HDG1-XI.

           EJECT
       C217-BUILD-REC-TYPE-6.

           MOVE 'C217'      TO CA-PARAGRAPH-NBR.

           MOVE +10     TO W0001-IX.

           MOVE F-RPTID-X         IN DCLT231RPT
             TO M-HDG2-XI.

           EJECT
       C218-BUILD-REC-TYPE-7.

           MOVE 'C218'      TO CA-PARAGRAPH-NBR.

           MOVE +11     TO W0001-IX.

           MOVE F-RPTID-X         IN DCLT231RPT
             TO M-HDG3-X1I.

           EJECT
       C219-BUILD-REC-TYPE-8.

           MOVE 'C219'      TO CA-PARAGRAPH-NBR.

           MOVE +12     TO W0001-IX.

           MOVE F-RPTID-X         IN DCLT231RPT
             TO M-HDG3-X2I.

           EJECT
       D000-UPDATE-CURRENT-REPORT.

           MOVE 'D000'      TO CA-PARAGRAPH-NBR.

           PERFORM D200-DELETE-T231RPT-LINES.

           IF  NO-ERRORS
               PERFORM E000-INSERT-REPORT-LINES
           END-IF.

           IF  NO-ERRORS
               MOVE -1             TO M-RPTID-XL
               SET ERRORS          TO TRUE
               MOVE W9999-MSG-013  TO M-MSG-22I
           ELSE
               PERFORM Y600-ROLLBACK
           END-IF.

           EJECT
       D100-VALIDATE-SCREEN-FIELDS.

           MOVE 'D100'      TO CA-PARAGRAPH-NBR.

           EJECT
       D200-DELETE-T231RPT-LINES.

           MOVE 'D200'      TO CA-PARAGRAPH-NBR.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.

           EXEC SQL
                DELETE FROM D231.T231RPT
                 WHERE F_RPTID_C    = :DCLT231RPT.F-RPTID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       D210-BUILD-REC-TYPE-1.

           MOVE 'D210'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '1'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE M-PGBRK-CI
             TO F-PRNT-C          IN DCLT231RPT.
           MOVE M-RPTFMT-CI
             TO F-RPTFMT-C        IN DCLT231RPT.
           MOVE M-STDRPT-CI
             TO F-STDRPT-C        IN DCLT231RPT.
           MOVE M-ELIM-CI
             TO F-ELIM-C          IN DCLT231RPT.
           MOVE M-COLCALC-CI
             TO F-COLCALC-C       IN DCLT231RPT.
           MOVE M-ORG-CI
             TO F-ORG-C           IN DCLT231RPT.
           MOVE M-RGN-CI
             TO F-RGN-C           IN DCLT231RPT.
           MOVE M-LN-CI
             TO F-LN-C            IN DCLT231RPT.
           MOVE M-COL-CI
             TO F-COL-C           IN DCLT231RPT.
           MOVE M-RPTID-XI
             TO F-RPTID-X         IN DCLT231RPT.

           EJECT
       D220-BUILD-REC-TYPE-2.

           MOVE 'D220'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '2'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE M-PRNT-C1I
             TO F-RPTFMT-C        IN DCLT231RPT.
           MOVE M-P1C01-CI
             TO F-PD01-C          IN DCLT231RPT.
           MOVE M-P1C02-CI
             TO F-PD02-C          IN DCLT231RPT.
           MOVE M-P1C03-CI
             TO F-PD03-C          IN DCLT231RPT.
           MOVE M-P1C04-CI
             TO F-PD04-C          IN DCLT231RPT.
           MOVE M-P1C05-CI
             TO F-PD05-C          IN DCLT231RPT.
           MOVE M-P1C06-CI
             TO F-PD06-C          IN DCLT231RPT.
           MOVE M-P1C07-CI
             TO F-PD07-C          IN DCLT231RPT.
           MOVE M-P1C08-CI
             TO F-PD08-C          IN DCLT231RPT.
           MOVE M-P1C09-CI
             TO F-PD09-C          IN DCLT231RPT.
           MOVE M-P1C10-CI
             TO F-PD10-C          IN DCLT231RPT.
           MOVE M-P1C11-CI
             TO F-PD11-C          IN DCLT231RPT.

           EJECT
       D230-BUILD-REC-TYPE-3.

           MOVE 'D230'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '3'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE M-PRNT-C2I
             TO F-RPTFMT-C        IN DCLT231RPT.
           MOVE M-P2C01-CI
             TO F-PD01-C          IN DCLT231RPT.
           MOVE M-P2C02-CI
             TO F-PD02-C          IN DCLT231RPT.
           MOVE M-P2C03-CI
             TO F-PD03-C          IN DCLT231RPT.
           MOVE M-P2C04-CI
             TO F-PD04-C          IN DCLT231RPT.
           MOVE M-P2C05-CI
             TO F-PD05-C          IN DCLT231RPT.
           MOVE M-P2C06-CI
             TO F-PD06-C          IN DCLT231RPT.
           MOVE M-P2C07-CI
             TO F-PD07-C          IN DCLT231RPT.
           MOVE M-P2C08-CI
             TO F-PD08-C          IN DCLT231RPT.
           MOVE M-P2C09-CI
             TO F-PD09-C          IN DCLT231RPT.
           MOVE M-P2C10-CI
             TO F-PD10-C          IN DCLT231RPT.
           MOVE M-P2C11-CI
             TO F-PD11-C          IN DCLT231RPT.

           EJECT
       D240-BUILD-REC-TYPE-4.

           MOVE 'D240'      TO CA-PARAGRAPH-NBR.

           IF M-PD01-CI (W0001-IX) > SPACES
           OR M-PD02-CI (W0001-IX) > SPACES
           OR M-PD03-CI (W0001-IX) > SPACES
           OR M-PD04-CI (W0001-IX) > SPACES
           OR M-PD05-CI (W0001-IX) > SPACES
           OR M-PD06-CI (W0001-IX) > SPACES
           OR M-PD07-CI (W0001-IX) > SPACES
           OR M-PD08-CI (W0001-IX) > SPACES
           OR M-PD09-CI (W0001-IX) > SPACES
           OR M-PD10-CI (W0001-IX) > SPACES
           OR M-PD11-CI (W0001-IX) > SPACES
           OR M-PD12-CI (W0001-IX) > SPACES
           OR M-PD13-CI (W0001-IX) > SPACES
           OR M-PD14-CI (W0001-IX) > SPACES
               INITIALIZE DCLT231RPT
               MOVE M-RPTID-CI
                 TO F-RPTID-C         IN DCLT231RPT
               MOVE '4'
                 TO DB-RECTYP-C       IN DCLT231RPT
               MOVE W0001-IX
                 TO A-SEQ-N           IN DCLT231RPT
               PERFORM D241-BUILD-REC-TYPE-4
               PERFORM E300-INSERT-T231RPT
           END-IF.

           EJECT
       D241-BUILD-REC-TYPE-4.

           MOVE 'D241'      TO CA-PARAGRAPH-NBR.

           MOVE M-PRNT-C3I  (W0001-IX)
             TO F-RPTFMT-C  IN DCLT231RPT.
           MOVE M-PD01-CI   (W0001-IX)
             TO F-PD01-C    IN DCLT231RPT.
           MOVE M-PD02-CI   (W0001-IX)
             TO F-PD02-C    IN DCLT231RPT.
           MOVE M-PD03-CI   (W0001-IX)
             TO F-PD03-C    IN DCLT231RPT.
           MOVE M-PD04-CI   (W0001-IX)
             TO F-PD04-C    IN DCLT231RPT.
           MOVE M-PD05-CI   (W0001-IX)
             TO F-PD05-C    IN DCLT231RPT.
           MOVE M-PD06-CI   (W0001-IX)
             TO F-PD06-C    IN DCLT231RPT.
           MOVE M-PD07-CI   (W0001-IX)
             TO F-PD07-C    IN DCLT231RPT.
           MOVE M-PD08-CI   (W0001-IX)
             TO F-PD08-C    IN DCLT231RPT.
           MOVE M-PD09-CI   (W0001-IX)
             TO F-PD09-C    IN DCLT231RPT.
           MOVE M-PD10-CI   (W0001-IX)
             TO F-PD10-C    IN DCLT231RPT.
           MOVE M-PD11-CI   (W0001-IX)
             TO F-PD11-C    IN DCLT231RPT.
           MOVE M-PD12-CI   (W0001-IX)
             TO F-PD12-C    IN DCLT231RPT.
           MOVE M-PD13-CI   (W0001-IX)
             TO F-PD13-C    IN DCLT231RPT.
           MOVE M-PD14-CI   (W0001-IX)
             TO F-PD14-C    IN DCLT231RPT.

           EJECT
       D250-BUILD-REC-TYPE-5.

           MOVE 'D250'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '5'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE M-HDG1-XI
             TO F-RPTID-X         IN DCLT231RPT.

           EJECT
       D260-BUILD-REC-TYPE-6.

           MOVE 'D260'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '6'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE M-HDG2-XI
             TO F-RPTID-X         IN DCLT231RPT.

           EJECT
       D270-BUILD-REC-TYPE-7.

           MOVE 'D270'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '7'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE M-HDG3-X1I
             TO F-RPTID-X         IN DCLT231RPT.

           EJECT
       D280-BUILD-REC-TYPE-8.

           MOVE 'D280'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '8'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE M-HDG3-X2I
             TO F-RPTID-X         IN DCLT231RPT.

           EJECT
       D290-BUILD-REC-CMNT-1.

           MOVE 'D291'      TO CA-PARAGRAPH-NBR.

           INITIALIZE DCLT231RPT.

           MOVE M-RPTID-CI
             TO F-RPTID-C         IN DCLT231RPT.
           MOVE '/'
             TO DB-RECTYP-C       IN DCLT231RPT.
           MOVE +1
             TO A-SEQ-N           IN DCLT231RPT.

           MOVE M-CMNT-XI
             TO F-RPTID-X         IN DCLT231RPT.

           EJECT
       E000-INSERT-REPORT-LINES.

           MOVE 'E000'      TO CA-PARAGRAPH-NBR.

           PERFORM D100-VALIDATE-SCREEN-FIELDS.

           IF  NO-ERRORS
               PERFORM E200-INSERT-T231RPT-LINES
           END-IF.

           IF  NO-ERRORS
               MOVE -1             TO M-RPTID-XL
               MOVE W9999-MSG-012  TO M-MSG-22I
           ELSE
               PERFORM Y600-ROLLBACK
           END-IF.

           EJECT
       E200-INSERT-T231RPT-LINES.

           MOVE 'E200'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               PERFORM D210-BUILD-REC-TYPE-1
               PERFORM E300-INSERT-T231RPT
           END-IF.

           IF  NO-ERRORS
               PERFORM D220-BUILD-REC-TYPE-2
               PERFORM E300-INSERT-T231RPT
           END-IF.

           IF  NO-ERRORS
               PERFORM D230-BUILD-REC-TYPE-3
               PERFORM E300-INSERT-T231RPT
           END-IF.

           IF  NO-ERRORS
               PERFORM D240-BUILD-REC-TYPE-4
                    VARYING W0001-IX FROM 1 BY 1
                      UNTIL W0001-IX > 4
           END-IF.

           IF  NO-ERRORS
               PERFORM D250-BUILD-REC-TYPE-5
               PERFORM E300-INSERT-T231RPT
           END-IF.

           IF  NO-ERRORS
               PERFORM D260-BUILD-REC-TYPE-6
               PERFORM E300-INSERT-T231RPT
           END-IF.

           IF  NO-ERRORS
               PERFORM D270-BUILD-REC-TYPE-7
               PERFORM E300-INSERT-T231RPT
           END-IF.

           IF  NO-ERRORS
               PERFORM D280-BUILD-REC-TYPE-8
               PERFORM E300-INSERT-T231RPT
           END-IF.

           IF  NO-ERRORS
               PERFORM D290-BUILD-REC-CMNT-1
               PERFORM E300-INSERT-T231RPT
           END-IF.

           EJECT
       E300-INSERT-T231RPT.

           MOVE 'E300'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
             INSERT INTO D231.T231RPT
                 ( F_RPTID_C
                 , DB_RECTYP_C
                 , A_SEQ_N
                 , F_PRNT_C
                 , F_RPTFMT_C
                 , F_STDRPT_C
                 , F_ELIM_C
                 , F_COLCALC_C
                 , F_ORG_C
                 , F_RGN_C
                 , F_LN_C
                 , F_COL_C
                 , F_RPTID_X
                 , F_PD01_C
                 , F_PD02_C
                 , F_PD03_C
                 , F_PD04_C
                 , F_PD05_C
                 , F_PD06_C
                 , F_PD07_C
                 , F_PD08_C
                 , F_PD09_C
                 , F_PD10_C
                 , F_PD11_C
                 , F_PD12_C
                 , F_PD13_C
                 , F_PD14_C
                 , DB_UPD_D
                 , DB_UPD_T )
             VALUES
                 ( :DCLT231RPT.F-RPTID-C
                 , :DCLT231RPT.DB-RECTYP-C
                 , :DCLT231RPT.A-SEQ-N
                 , :DCLT231RPT.F-PRNT-C
                 , :DCLT231RPT.F-RPTFMT-C
                 , :DCLT231RPT.F-STDRPT-C
                 , :DCLT231RPT.F-ELIM-C
                 , :DCLT231RPT.F-COLCALC-C
                 , :DCLT231RPT.F-ORG-C
                 , :DCLT231RPT.F-RGN-C
                 , :DCLT231RPT.F-LN-C
                 , :DCLT231RPT.F-COL-C
                 , :DCLT231RPT.F-RPTID-X
                 , :DCLT231RPT.F-PD01-C
                 , :DCLT231RPT.F-PD02-C
                 , :DCLT231RPT.F-PD03-C
                 , :DCLT231RPT.F-PD04-C
                 , :DCLT231RPT.F-PD05-C
                 , :DCLT231RPT.F-PD06-C
                 , :DCLT231RPT.F-PD07-C
                 , :DCLT231RPT.F-PD08-C
                 , :DCLT231RPT.F-PD09-C
                 , :DCLT231RPT.F-PD10-C
                 , :DCLT231RPT.F-PD11-C
                 , :DCLT231RPT.F-PD12-C
                 , :DCLT231RPT.F-PD13-C
                 , :DCLT231RPT.F-PD14-C
                 , CURRENT DATE
                 , CURRENT TIME )
           END-EXEC.

           SET DUP-KEY        TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               CONTINUE
           ELSE
               MOVE -1             TO M-RPTID-XL
               SET ERRORS          TO TRUE
               MOVE W9999-MSG-022  TO M-MSG-22I
           END-IF.

           EJECT
       F000-PROCESS-ENTER-KEY.

           MOVE 'F000'      TO CA-PARAGRAPH-NBR.

           PERFORM F100-VALIDATE-KEY-FIELD.

           IF  NO-ERRORS
               EVALUATE TRUE
                   WHEN DISPLAY-REGIONS
                        MOVE M-KEY-CI TO WS-M-MAX-RGN-C
                   WHEN DISPLAY-LINES
                        MOVE M-KEY-CI TO WS-M-MAX-LN-C
                   WHEN DISPLAY-COLUMNS
                        MOVE M-KEY-CI TO WS-M-MAX-COL-C
                   WHEN DISPLAY-ORGS
                        MOVE M-KEY-CI TO WS-M-MAX-ORG-C
                   WHEN DISPLAY-MNEMONICS
                        MOVE M-KEY-CI TO WS-M-MAX-MNEM-C
               END-EVALUATE

               PERFORM H000-PROCESS-NEXT-PAGE

               MOVE SPACES            TO M-KEY-CI
           END-IF.

           IF  NO-ERRORS
               MOVE -1             TO M-KEY-CL
               MOVE W9999-MSG-001  TO M-MSG-22AI
           END-IF.

           EJECT
       F100-VALIDATE-KEY-FIELD.

           MOVE 'F100'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               MOVE -1             TO M-KEY-CL
               MOVE W9999-MSG-001  TO M-MSG-22AI
           END-IF.

           EJECT
       G000-PROCESS-PREV-PAGE.

           MOVE 'G000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               EVALUATE TRUE
                   WHEN DISPLAY-REGIONS
                        PERFORM G100-PROCESS-CSR-R2
                   WHEN DISPLAY-LINES
                        PERFORM G200-PROCESS-CSR-L2
                   WHEN DISPLAY-COLUMNS
                        PERFORM G300-PROCESS-CSR-C2
                   WHEN DISPLAY-ORGS
                        PERFORM G400-PROCESS-CSR-O2
                   WHEN DISPLAY-MNEMONICS
                        PERFORM G500-PROCESS-CSR-M2
               END-EVALUATE

               IF  W0001-IX >= 1 AND < W0001-SCREEN-A-LN-LIMIT
                   PERFORM UNTIL W0001-IX < 1
                       PERFORM G010-MOVE-BLANKS-TO-SCREEN
                       SUBTRACT +1 FROM W0001-IX
                   END-PERFORM
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-A-LN-LIMIT
                   PERFORM G010-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  M-DATA-XI (1) EQUAL SPACES
               INITIALIZE WS-M-MAX-VALUES
               SET NO-ERRORS      TO TRUE
               PERFORM H000-PROCESS-NEXT-PAGE
               MOVE -1            TO M-KEY-CL
               SET ERRORS         TO TRUE
               MOVE W9999-MSG-005 TO M-MSG-22AI
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-ACT-CL(1)
               MOVE W9999-MSG-003 TO M-MSG-22AI
           END-IF.

           EJECT
       G010-MOVE-BLANKS-TO-SCREEN.

           MOVE 'G010'      TO CA-PARAGRAPH-NBR.

           MOVE SPACES TO M-ACT-CI       (W0001-IX)
                          M-DATA-XI      (W0001-IX).

           EJECT
       G100-PROCESS-CSR-R2.

           MOVE 'G100'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-MIN-RGN-C    TO F-RGN-C      IN DCLT231RGN.
           MOVE WS-M-MIN-RECTYP-C TO DB-RECTYP-C  IN DCLT231RGN.

           EXEC SQL
                OPEN CSR_R2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-A-LN-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_R2
                     INTO :DCLT231RGN.F-RGN-C
                        , :DCLT231RGN.DB-RECTYP-C
                        , :DCLT231RGN.F-RGN-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0002-T231RGN

                   MOVE F-RGN-C      IN DCLT231RGN
                     TO W0002-F-RGN-C
                   MOVE F-RGN-X      IN DCLT231RGN
                     TO W0002-F-RGN-X

                   MOVE W0002-T231RGN
                     TO M-DATA-XI         (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-A-LN-LIMIT
                       MOVE F-RGN-C      IN DCLT231RGN
                         TO WS-M-MAX-RGN-C
                       MOVE DB-RECTYP-C  IN DCLT231RGN
                         TO WS-M-MAX-RECTYP-C
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-RGN-C      IN DCLT231RGN
             TO WS-M-MIN-RGN-C.
           MOVE DB-RECTYP-C  IN DCLT231RGN
             TO WS-M-MIN-RECTYP-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-KEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_R2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       G200-PROCESS-CSR-L2.

           MOVE 'G200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-MIN-LN-C     TO F-LN-C       IN DCLT231LINE.
           MOVE WS-M-MIN-RECTYP-C TO DB-RECTYP-C  IN DCLT231LINE.
           MOVE WS-M-MIN-LN-N     TO F-LN-N       IN DCLT231LINE.
           MOVE WS-M-MIN-SEQ-N    TO A-SEQ-N      IN DCLT231LINE.

           EXEC SQL
                OPEN CSR_L2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-A-LN-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_L2
                     INTO :DCLT231LINE.F-LN-C
                        , :DCLT231LINE.F-LN-N
                        , :DCLT231LINE.A-SEQ-N
                        , :DCLT231LINE.F-LN-X
                        , :DCLT231LINE.DB-RECTYP-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0002-T231LINE

                   MOVE F-LN-C       IN DCLT231LINE
                     TO W0002-F-LN-C
                   MOVE F-LN-X       IN DCLT231LINE
                     TO W0002-F-LN-X

                   MOVE W0002-T231LINE
                     TO M-DATA-XI         (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-A-LN-LIMIT
                       MOVE F-LN-C       IN DCLT231LINE
                         TO WS-M-MAX-LN-C
                       MOVE DB-RECTYP-C  IN DCLT231LINE
                         TO WS-M-MAX-RECTYP-C
                       MOVE F-LN-N       IN DCLT231LINE
                         TO WS-M-MAX-LN-N
                       MOVE A-SEQ-N      IN DCLT231LINE
                         TO WS-M-MAX-SEQ-N
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-LN-C       IN DCLT231LINE
             TO WS-M-MIN-LN-C.
           MOVE DB-RECTYP-C  IN DCLT231LINE
             TO WS-M-MIN-RECTYP-C.
           MOVE F-LN-N       IN DCLT231LINE
             TO WS-M-MIN-LN-N.
           MOVE A-SEQ-N      IN DCLT231LINE
             TO WS-M-MIN-SEQ-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-KEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_L2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       G300-PROCESS-CSR-C2.

           MOVE 'G300'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-MIN-COL-C    TO F-COL-C      IN DCLT231COL.
           MOVE WS-M-MIN-RECTYP-C TO DB-RECTYP-C  IN DCLT231COL.
           MOVE WS-M-MIN-COL-N    TO F-COL-N      IN DCLT231COL.

           EXEC SQL
                OPEN CSR_C2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-A-LN-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_C2
                     INTO :DCLT231COL.F-COL-C
                        , :DCLT231COL.DB-RECTYP-C
                        , :DCLT231COL.F-COL-N
                        , :DCLT231COL.F-COL-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0002-T231COL

                   MOVE F-COL-C      IN DCLT231COL
                     TO W0002-F-COL-C
                   MOVE F-COL-X      IN DCLT231COL
                     TO W0002-F-COL-X

                   MOVE W0002-T231COL
                     TO M-DATA-XI         (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-A-LN-LIMIT
                       MOVE F-COL-C      IN DCLT231COL
                         TO WS-M-MAX-COL-C
                       MOVE DB-RECTYP-C  IN DCLT231COL
                         TO WS-M-MAX-RECTYP-C
                       MOVE F-COL-N      IN DCLT231COL
                         TO WS-M-MAX-COL-N
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-COL-C      IN DCLT231COL
             TO WS-M-MIN-COL-C.
           MOVE DB-RECTYP-C  IN DCLT231COL
             TO WS-M-MIN-RECTYP-C.
           MOVE F-COL-N      IN DCLT231COL
             TO WS-M-MIN-COL-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-KEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_C2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       G400-PROCESS-CSR-O2.

           MOVE 'G400'      TO CA-PARAGRAPH-NBR.

           MOVE +1 TO W0001-IX.

           MOVE 'O1'
             TO W0002-F-ORG-C
           MOVE 'TOTSDVDIVGRPSAGGAGDIRSKGKLGFKGFAM'
             TO W0002-F-ORG-X

           MOVE W0002-T231ORG
             TO M-DATA-XI         (W0001-IX).

           MOVE +2 TO W0001-IX.

           MOVE '  '
             TO W0002-F-ORG-C
           MOVE '  '
             TO W0002-F-ORG-X

           MOVE W0002-T231ORG
             TO M-DATA-XI         (W0001-IX).

           EJECT
       G500-PROCESS-CSR-M2.

           MOVE 'G500'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-MIN-MNEM-C   TO F-MNEM-C     IN DCLT231MNEM.

           EXEC SQL
                OPEN CSR_M2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE W0001-SCREEN-A-LN-LIMIT TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX < 1
               EXEC SQL
                    FETCH CSR_M2
                     INTO :DCLT231MNEM.F-MNEM-C
                        , :DCLT231MNEM.F-PDHDG01-C
                        , :DCLT231MNEM.F-PDHDG02-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   INITIALIZE W0002-T231MNEM

                   MOVE F-MNEM-C     IN DCLT231MNEM
                     TO W0002-F-MNEM-C
                   MOVE F-PDHDG01-C  IN DCLT231MNEM
                     TO W0002-F-PDHDG01-C
                   MOVE F-PDHDG02-C  IN DCLT231MNEM
                     TO W0002-F-PDHDG02-C

                   MOVE W0002-T231MNEM
                     TO M-DATA-XI         (W0001-IX)

                   IF  W0001-IX = W0001-SCREEN-A-LN-LIMIT
                       MOVE F-MNEM-C     IN DCLT231MNEM
                         TO WS-M-MAX-MNEM-C
                   END-IF

                   SUBTRACT +1 FROM W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-MNEM-C     IN DCLT231MNEM
             TO WS-M-MIN-MNEM-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-005  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-KEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_M2
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       H000-PROCESS-NEXT-PAGE.

           MOVE 'H000'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               EVALUATE TRUE
                   WHEN DISPLAY-REGIONS
                        PERFORM H100-PROCESS-CSR-R1
                   WHEN DISPLAY-LINES
                        PERFORM H200-PROCESS-CSR-L1
                   WHEN DISPLAY-COLUMNS
                        PERFORM H300-PROCESS-CSR-C1
                   WHEN DISPLAY-ORGS
                        PERFORM H400-PROCESS-CSR-O1
                   WHEN DISPLAY-MNEMONICS
                        PERFORM H500-PROCESS-CSR-M1
               END-EVALUATE

               IF  W0001-IX > 1 AND <= W0001-SCREEN-A-LN-LIMIT
                   PERFORM UNTIL W0001-IX > W0001-SCREEN-A-LN-LIMIT
                       PERFORM G010-MOVE-BLANKS-TO-SCREEN
                       ADD +1 TO W0001-IX
                   END-PERFORM
               ELSE
                   IF  W0001-IX = 1 AND EIBAID = DFHENTER
                       PERFORM VARYING W0001-IX FROM 1 BY 1
                         UNTIL W0001-IX > W0001-SCREEN-A-LN-LIMIT
                           PERFORM G010-MOVE-BLANKS-TO-SCREEN
                       END-PERFORM
                   END-IF
               END-IF
           ELSE
               PERFORM VARYING W0001-IX FROM 1 BY 1
                 UNTIL W0001-IX > W0001-SCREEN-A-LN-LIMIT
                   PERFORM G010-MOVE-BLANKS-TO-SCREEN
               END-PERFORM
           END-IF.

           IF  NO-ERRORS
               MOVE -1            TO M-ACT-CL(1)
               MOVE W9999-MSG-003 TO M-MSG-22AI
           END-IF.

           EJECT
       H100-PROCESS-CSR-R1.

           MOVE 'H100'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-MAX-RGN-C    TO F-RGN-C      IN DCLT231RGN.
           MOVE WS-M-MAX-RECTYP-C TO DB-RECTYP-C  IN DCLT231RGN.

           EXEC SQL
                OPEN CSR_R1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-A-LN-LIMIT
               EXEC SQL
                    FETCH CSR_R1
                     INTO :DCLT231RGN.F-RGN-C
                        , :DCLT231RGN.DB-RECTYP-C
                        , :DCLT231RGN.F-RGN-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-RGN-C      IN DCLT231RGN
                         TO WS-M-MIN-RGN-C
                       MOVE DB-RECTYP-C  IN DCLT231RGN
                         TO WS-M-MIN-RECTYP-C
                   END-IF

                   INITIALIZE W0002-T231RGN

                   MOVE F-RGN-C      IN DCLT231RGN
                     TO W0002-F-RGN-C
                   MOVE F-RGN-X      IN DCLT231RGN
                     TO W0002-F-RGN-X

                   MOVE W0002-T231RGN
                     TO M-DATA-XI         (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-RGN-C      IN DCLT231RGN
             TO WS-M-MAX-RGN-C.
           MOVE DB-RECTYP-C  IN DCLT231RGN
             TO WS-M-MAX-RECTYP-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-KEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_R1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       H200-PROCESS-CSR-L1.

           MOVE 'H200'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-MAX-LN-C     TO F-LN-C       IN DCLT231LINE.
           MOVE WS-M-MAX-RECTYP-C TO DB-RECTYP-C  IN DCLT231LINE.
           MOVE WS-M-MAX-LN-N     TO F-LN-N       IN DCLT231LINE.
           MOVE WS-M-MAX-SEQ-N    TO A-SEQ-N      IN DCLT231LINE.

           EXEC SQL
                OPEN CSR_L1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-A-LN-LIMIT
               EXEC SQL
                    FETCH CSR_L1
                     INTO :DCLT231LINE.F-LN-C
                        , :DCLT231LINE.F-LN-N
                        , :DCLT231LINE.A-SEQ-N
                        , :DCLT231LINE.F-LN-X
                        , :DCLT231LINE.DB-RECTYP-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-LN-C       IN DCLT231LINE
                         TO WS-M-MIN-LN-C
                       MOVE DB-RECTYP-C  IN DCLT231LINE
                         TO WS-M-MIN-RECTYP-C
                       MOVE F-LN-N       IN DCLT231LINE
                         TO WS-M-MIN-LN-N
                       MOVE A-SEQ-N      IN DCLT231LINE
                         TO WS-M-MIN-SEQ-N
                   END-IF

                   INITIALIZE W0002-T231LINE

                   MOVE F-LN-C       IN DCLT231LINE
                     TO W0002-F-LN-C
                   MOVE F-LN-X       IN DCLT231LINE
                     TO W0002-F-LN-X

                   MOVE W0002-T231LINE
                     TO M-DATA-XI         (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-LN-C       IN DCLT231LINE
             TO WS-M-MAX-LN-C.
           MOVE DB-RECTYP-C  IN DCLT231LINE
             TO WS-M-MAX-RECTYP-C.
           MOVE F-LN-N       IN DCLT231LINE
             TO WS-M-MAX-LN-N.
           MOVE A-SEQ-N      IN DCLT231LINE
             TO WS-M-MAX-SEQ-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-KEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_L1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       H300-PROCESS-CSR-C1.

           MOVE 'H300'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-MAX-COL-C    TO F-COL-C      IN DCLT231COL.
           MOVE WS-M-MAX-RECTYP-C TO DB-RECTYP-C  IN DCLT231COL.
           MOVE WS-M-MAX-COL-N    TO F-COL-N      IN DCLT231COL.

           EXEC SQL
                OPEN CSR_C1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-A-LN-LIMIT
               EXEC SQL
                    FETCH CSR_C1
                     INTO :DCLT231COL.F-COL-C
                        , :DCLT231COL.DB-RECTYP-C
                        , :DCLT231COL.F-COL-N
                        , :DCLT231COL.F-COL-X
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-COL-C      IN DCLT231COL
                         TO WS-M-MIN-COL-C
                       MOVE DB-RECTYP-C  IN DCLT231COL
                         TO WS-M-MIN-RECTYP-C
                       MOVE F-COL-N      IN DCLT231COL
                         TO WS-M-MIN-COL-N
                   END-IF

                   INITIALIZE W0002-T231COL

                   MOVE F-COL-C      IN DCLT231COL
                     TO W0002-F-COL-C
                   MOVE F-COL-X      IN DCLT231COL
                     TO W0002-F-COL-X

                   MOVE W0002-T231COL
                     TO M-DATA-XI         (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-COL-C      IN DCLT231COL
             TO WS-M-MAX-COL-C.
           MOVE DB-RECTYP-C  IN DCLT231COL
             TO WS-M-MAX-RECTYP-C.
           MOVE F-COL-N      IN DCLT231COL
             TO WS-M-MAX-COL-N.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-KEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_C1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
       H400-PROCESS-CSR-O1.

           MOVE 'H400'      TO CA-PARAGRAPH-NBR.

           MOVE +1 TO W0001-IX.

           MOVE 'O1'
             TO W0002-F-ORG-C
           MOVE 'TOTSDVDIVGRPSAGGAGDIRSKGKLGFKGFAM'
             TO W0002-F-ORG-X

           MOVE W0002-T231ORG
             TO M-DATA-XI         (W0001-IX).

           MOVE +2 TO W0001-IX.

           MOVE '  '
             TO W0002-F-ORG-C
           MOVE '  '
             TO W0002-F-ORG-X

           MOVE W0002-T231ORG
             TO M-DATA-XI         (W0001-IX).

           EJECT
       H500-PROCESS-CSR-M1.

           MOVE 'H500'      TO CA-PARAGRAPH-NBR.

           MOVE WS-M-MAX-MNEM-C   TO F-MNEM-C     IN DCLT231MNEM.

           EXEC SQL
                OPEN CSR_M1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           MOVE +1 TO W0001-IX.

           PERFORM UNTIL SQLCODE NOT EQUAL ZERO
                      OR W0001-IX > W0001-SCREEN-A-LN-LIMIT
               EXEC SQL
                    FETCH CSR_M1
                     INTO :DCLT231MNEM.F-MNEM-C
                        , :DCLT231MNEM.F-PDHDG01-C
                        , :DCLT231MNEM.F-PDHDG02-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
                   IF  W0001-IX = 1
                       MOVE F-MNEM-C     IN DCLT231MNEM
                         TO WS-M-MIN-MNEM-C
                   END-IF

                   INITIALIZE W0002-T231MNEM

                   MOVE F-MNEM-C     IN DCLT231MNEM
                     TO W0002-F-MNEM-C
                   MOVE F-PDHDG01-C  IN DCLT231MNEM
                     TO W0002-F-PDHDG01-C
                   MOVE F-PDHDG02-C  IN DCLT231MNEM
                     TO W0002-F-PDHDG02-C

                   MOVE W0002-T231MNEM
                     TO M-DATA-XI         (W0001-IX)

                   ADD +1 TO W0001-IX
               END-IF
           END-PERFORM.

           MOVE F-MNEM-C     IN DCLT231MNEM
             TO WS-M-MAX-MNEM-C.

           IF  DB2-END-OF-FILE
               MOVE W9999-MSG-004  TO M-MSG-22AI
               SET ERRORS          TO TRUE
               MOVE -1             TO M-KEY-CL
           END-IF.

           EXEC SQL
               CLOSE CSR_M1
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EJECT
      **===========================================================**
      **   COPYBOOK AREA FOR CICS CONTROL AND SUB-MODULES          **
      **===========================================================**
           EXEC SQL
              INCLUDE C108Z000
           END-EXEC.

           EJECT
           COPY C108Z900.

           EJECT
           COPY C108Z998.

